.TITLE IMAGE MODE FTP					;IFTP.MAC

.MCALL ALUN$S,GLUN$S,QIOW$S,EXIT$S,GREG$S
.MCALL FDBDF$,FDAT$A,FDRC$A,FDBK$A,FDOP$A,FINIT$,FSRSZ$
.MCALL OPEN$W,CLOSE$,WRITE$,WAIT$

        .BLKW 100                       ;Make some stack space
SPSTRT:

REGBUF: .BLKW 3                         ;To stick region info into

WRSTS:  .WORD 0                         ;Write status block

IOSTAT: .WORD 0,0                       ;Status for disk ops

NUMBUF: .BLKB 12.
BUFPTR: .WORD 0
FILDON: .WORD 0
ALLDON: .WORD 1

FDB:    FDBDF$                          ;Make up disk header info.Include write chk.
;       FDAT$A  R.FIX,,512.,-120.        ;Fixed length records: text & .OLB files
        FDAT$A  R.VAR,,52.,-120.       	 ;Use this for .OBJ files
        FDRC$A  FD.RWM
        FDBK$A  BUFFER,512.,,2,IOSTAT
        FDOP$A  2,DATSET
        FSRSZ$  0

BUFFER: .WORD 1,2,3,4,5,6
        .BLKW 256.                      ;Disk block buffer

DATSET: .WORD 4,DEVNAM,9.,UIC,7,FILNAM
DEVNAM: .ASCII /DK1:/
UIC:    .ASCII /[200,200]/
FILNAM: .ASCII /A.OBJ;1/
.EVEN

START:  MOV #SPSTRT,SP                  ;Set up stack???
        ALUN$S #1,#"TI,#0               ;LUN 1 is TI: device
        BCC 1$
        IOT                             ;Punt if error
1$:     QIOW$S #IO.ATT,#1,#1            ;Attach it
        BCC 2$
        IOT                             ;Punt if error

2$:     GREG$S ,#REGBUF                 ;Get region base address
        BCC 3$
        IOT
3$:     MOV REGBUF,R1
        JSR PC,OUTNUM                   ;Print it out
        MOV #BUFPTR,R1                  ;Give local address of buffer pointer
        JSR PC,OUTNUM                   ;Print it out

        ALUN$S #2,#"DK,#3               ;LUN 2 is DK3:
        BCC 4$
        IOT                             ;Punt if error
4$:     FINIT$
        BCC FLOOP
        IOT     

FLOOP:  TST ALLDON                      ;Is 10 still there?
        BNE 1$                          ; Yes
        JMP BYE                         ; No
1$:     TST FILDON                      ;Ready to write another file?
        BEQ FLOOP                       ; No - keep waiting

        OPEN$W #FDB,,,,,,ERROR          ;Open up the file

WLOOP:  MOV #BUFFER,BUFPTR              ;Tell 10 where to put data
1$:     TST FILDON                      ;See if 10 has more to write
        BEQ DONE                        ; No - all done with this file
        TST BUFPTR                      ; Yes - wait for it to fill buffer
        BNE 1$
        WRITE$ #FDB,,,,,,,ERROR         ;Write out the buffer
        WAIT$ #FDB,,,ERROR              ;Wait til it's written
        TSTB IOSTAT                     ;Did it get written out ok?
        BPL 2$
        IOT     
2$:     JMP WLOOP                       ;Go wait for the next block to write

DONE:   CLOSE$ #FDB,ERROR               ;All done with file now
        CLR BUFPTR
        INCB FILNAM                     ;Use new file name for next
        JMP FLOOP                       ;See if more to do

BYE:    EXIT$S ERROR                    ;Go away

ERROR:  IOT                             ;Crash if any errors

;Auxiliary routine to print out the octal number in R1

OUTNUM: MOV R0,-(SP)    ;We need some free registers
        MOV R1,-(SP)
        MOV R2,-(SP)
        MOV R3,-(SP)
        MOV #NUMBUF,R2  ;Where we'll stick the result
        CLR R0
        MOV #6,R3       ;6 digits to print
        ASHC #1,R0      ;Get high order digit
1$:     TST R0          ;Don't print leading zeros
        BNE 2$          ;Found highest order non-zero digit
        ASHC #3,R0      ;Try next
        SOB R3,1$
        INC R3
2$:     ADD #60,R0      ;Convert to ASCII
        MOVB R0,(R2)+   ;Stick it in buffer
        CLR R0
        ASHC #3,R0      ;Move on to next digit
        SOB R3,2$       ;Do them all
        SUB #NUMBUF,R2  ;Get character count for writing
        QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#NUMBUF,R2,#40>  ;Type it out
        BCS ERROR       ;Punt if error
        MOV (SP)+,R3    ;Restore registers
        MOV (SP)+,R2
        MOV (SP)+,R1
        MOV (SP)+,R0
        RTS PC

.END START